ITD | B Communication and Multimedia Design (CMD) - voltijd - versie 1.0
In dit hoofdstuk gaan we in op de onderwerpen bias, fairness en kansengelijkheid. Het doel is beter te begrijpen of er studenten zijn met minder kans op succes en of dit disproportioneel is. Dit kan duiden op kansenongelijkheid.
De analyse van kansengelijkheid heeft de volgende stappen:
We laden de bewerkte data en het beste prognosemodel in voor:
Opleiding: ITD | B Communication and Multimedia Design (Synth) (CMD), voltijd, eerstejaars - Retentie na 1 jaar
## Create a list of dfPersonas
lDfPersona <- list()
## Walk over the variables
lDfPersona <- map(lSensitive_labels,
~ Get_dfPersona_Recursive(.x)) |>
set_names(lSensitive_labels)
dfPersona_per_group <- bind_rows(lDfPersona)
## Save this file as an Excel spreadsheet
sOutputPath <- file.path("R/data", "dfPersona_per_group.xlsx")
writexl::write_xlsx(dfPersona_per_group, sOutputPath)
## Load the personas
dfPersona_all <- Get_dfPersona_Recursive()Om het model beter te begrijpen en te kunnen uitleggen, maken we met behulp van het DALEX package een explainer.
DALEX is onder andere ontwikkeld om uit te kunnen leggen welke verklarende variabelen van belang zijn en wat deze voor een effect hebben in een model. Een explainer is een model-onafhankelijke wrapper, die inzicht geeft in de voorspellingen van het model en de bijdrage van de variabelen aan de prognose. Een explainer maakt het verder mogelijk om modellen onderling te vergelijken en benchmarken.
# Select the best model
sBest_model <- dfModel_results$model[dfModel_results$best == TRUE]
last_fit <- lLast_fits[[sBest_model]]
fitted_model <- last_fit |>
extract_fit_parsnip()
# If the model is logistic regression, check that the coefficients of the model are numerical
if(sBest_model == "Logistic Regression") {
coefs <- tidy(fitted_model)$estimate
# Check that the coefficients are numerical
if (!is.numeric(coefs)) {
stop("De geëxtraheerde coëfficiënten zijn niet numeriek.")
}
}# Extract the fitted model
fitted_model <- last_fit |>
extract_fit_parsnip()
# Extract the workflow
workflow <- last_fit |>
extract_workflow()
# Create an explainer
explain_lf <- DALEX::explain(
model = workflow,
data = dfOpleiding_inschrijvingen |> select(-Retentie),
y = dfOpleiding_inschrijvingen$Retentie,
colorize = TRUE,
verbose = TRUE,
label = sBest_model)Preparation of a new explainer is initiated
-> model label : Random Forest
-> data : 1613 rows 26 cols
-> target variable : 1613 values
-> predict function : yhat.workflow will be used ( [33m default [39m )
-> predicted values : No value for predict function target column. ( [33m default [39m )
-> model_info : package tidymodels , ver. 1.2.0 , task classification ( [33m default [39m )
-> predicted values : numerical, min = 0.1759112 , mean = 0.6193215 , max = 0.9273344
-> residual function : difference between y and yhat ( [33m default [39m )
-> residuals : numerical, min = -0.841733 , mean = 0.001881272 , max = 0.7484622
[32m A new explainer has been created! [39m if(is.null(explain_lf$y_hat) || is.null(explain_lf$residuals)) {
cli::cli_alert_danger(glue::glue(
"The explainer does not contain the correct results. ",
"Check the installation of model packages: {glue::glue_collapse(explain_lf$model_info$package, sep = ', ')}"
))
stop("Solve this problem first")
}We onderzoeken kansengelijkheid door bias in de data te onderzoeken. Dit wordt ook wel een fairness analyse genoemd. Bias voor verschillende groepen studenten kan een teken zijn van kansenongelijkheid.
Het leidende werk voor fairness analyses is Fairness and Machine Learning: Limitations and Opportunities (Barocas et al., 2023). De methode die we in deze analyse hanteren hierop gebaseerd. We maken gebruik van de DALEX explainer en onderzoeken de invloed van de variabelen op de kans op retentie voor verschillende groepen studenten naar geslacht, aansluiting en vooropleiding.
De volgende definities zijn van belang:
Voor elke groep onderzoeken we 5 ratio’s, ook wel maatstaven of metrieken genoemd. Deze ratio’s zijn afgeleid van verhoudingen in de confusion matrix; ze geven inzicht in de mate van bias en kansengelijkheid vanuit verschillende perspectieven van een prognosemodel.
knitr::include_graphics(here::here("R/images", "confusion-matrix-fairness-lta-hhs.png"))
1. Accuracy Equality Ratio
In welke mate voorspelt het model zowel de positieve als negatieve uitkomsten goed?
Deze maatstaf wordt gebruikt om te beoordelen of een model even accuraat is voor verschillende subgroepen binnen de dataset. Het vergelijkt de nauwkeurigheid van het model voor een beschermde groep (een minderheidsgroep) met de nauwkeurigheid voor een bevoorrechte groep (de meerderheidsgroep). Deze ratio wordt berekend als de verhouding tussen de nauwkeurigheid voor de beschermde groep en de nauwkeurigheid voor de bevoorrechte groep.
Formule
\text{ACC} = \frac{TP + TN}{TP + FP + TN + FN}
Definities
Interpretatie
2. Equal Opportunity Ratio
In welke mate zijn de terecht positieve voorspellingen gelijk?
Deze maatstaf beoordeelt de gelijkheid van kansen die een model biedt aan verschillende subgroepen in termen van de ‘True Positive Rate’ (TPR). Het vergelijkt de kans dat een model correct een positieve uitkomst voorspelt voor een beschermde groep versus een bevoorrechte groep.
De True Positive Rate (TPR) is een andere term voor de sensitiviteit (ook wel recall) genoemd. De Equal Opportunity Ratio wordt berekend als het aantal true positives gedeeld door het totaal aantal werkelijke positives.
Formule
\text{TPR} = \frac{TP}{TP + FN}
Definities
Interpretatie
3. Predictive Equality Ratio
In welke mate zijn de vals positieve voorspellingen gelijk?
Deze maatstaf beoordeelt de gelijkheid van het aantal False Positives (vals-positieven) tussen verschillende subgroepen. Het vergelijkt de False Positive Rate (FPR) voor een beschermde groep met de FPR voor een bevoorrechte groep.
De FPR is de verhouding van het aantal vals-positieve voorspellingen (False Positives, FP) ten opzichte van het totaal aantal werkelijke negatieve gevallen (True Negatives, TN en False Positives, FP). De Predictive Equality Ratio wordt berekend als de verhouding tussen de FPR voor de beschermde groep en de FPR voor de bevoorrechte groep.
Formule
\text{FPR} = \frac{FP}{FP + TN}
Definities
Interpretatie
4. Predictive Parity Ratio
In welke mate zijn de terecht positieve voorspellingen gelijk?
Deze maatstaf beoordeelt de gelijkheid van de nauwkeurigheid van de voorspelling tussen verschillende subgroepen door de positieve voorspellende waarde (Positive Predictive Value, PPV) van het model voor een beschermde groep te vergelijken met die voor een bevoorrechte groep. De PVV wordt ook wel de precisie genoemd en wordt berekend als het aantal true positives (TP) gedeeld door het totaal aantal voorspelde positives (TP en FP). Het is een maat voor de nauwkeurigheid van de positieve voorspellingen van het model.
Formule
\text{PPV} = \frac{TP}{TP + FP}
Definities
Interpretatie
5. Statistical Parity Ratio
In welke mate zijn de positieve voorspellingen gelijk?
Deze maatstaf beoordeelt de gelijkheid van de positieve voorspellingen (ongeacht of ze correct zijn of niet) tussen verschillende subgroepen. Het vergelijkt de kans dat een model een positieve uitkomst voorspelt voor een beschermde groep met de kans dat het een positieve uitkomst voorspelt voor een bevoorrechte groep. De Statistical Parity Ratio wordt berekend als de verhouding tussen de kans op een positieve voorspelling voor de beschermde groep en de kans op een positieve voorspelling voor de bevoorrechte groep.
Formule
\text{SPR} = \frac{TP + FP}{TP + FP + TN + FN}
Definities
Interpretatie
Nu we deze begrippen hebben gedefinieerd, kunnen we de bias en kansengelijkheid van het model voor verschillende groepen studenten analyseren. Hiervoor gebruiken we het fairmodels package van DALEX.
Voor de variabelen Geslacht, Aansluiting en Vooropleiding is de verdeling binnen deze opleiding als volgt:
# Create a table with numbers and percentages for the 3 sensitive
tbl_summary <- dfOpleiding_inschrijvingen |>
select(Retentie, all_of(lSensitive_labels)) |>
mutate(Retentie = ifelse(Retentie == 1, "Ja", "Nee")) |>
tbl_summary(by = Retentie) |>
add_p(pvalue_fun = ~ style_pvalue(.x, digits = 2),
test.args = list(
all_tests("fisher.test") ~ list(simulate.p.value = TRUE),
all_tests("wilcox.test") ~ list(exact = FALSE)
)) |>
add_significance_stars(
hide_p = FALSE,
pattern = "{p.value}{stars}"
) |>
add_overall(col_label = "**Totaal** \nN = {style_number(N)}") |>
add_n() |>
modify_header(label ~ "**Variabele**") |>
modify_spanning_header(c("stat_1", "stat_2") ~ "**Retentie na 1 jaar**") |>
bold_labels() |>
as_flex_table() |>
flextable::border(border.top = fp_border(color = "grey")) |>
set_table_properties(width = 0.8, layout = "autofit")
# Print summary table
tbl_summary
| Retentie na 1 jaar |
| |||
|---|---|---|---|---|---|
Variabele | N | Totaal | Ja | Nee | p-value2 |
Geslacht | 1.613 | <0,001*** | |||
M | 915 (57%) | 521 (52%) | 394 (64%) | ||
V | 698 (43%) | 481 (48%) | 217 (36%) | ||
Aansluiting | 1.613 | <0,001*** | |||
Direct | 756 (47%) | 455 (45%) | 301 (49%) | ||
Tussenjaar | 176 (11%) | 125 (12%) | 51 (8,3%) | ||
Switch intern | 202 (13%) | 148 (15%) | 54 (8,8%) | ||
Switch extern | 445 (28%) | 254 (25%) | 191 (31%) | ||
2e Studie | 15 (0,9%) | 6 (0,6%) | 9 (1,5%) | ||
Na CD | 19 (1,2%) | 14 (1,4%) | 5 (0,8%) | ||
Overig | 0 (0%) | 0 (0%) | 0 (0%) | ||
Onbekend | 0 (0%) | 0 (0%) | 0 (0%) | ||
Vooropleiding | 1.613 | 0,014* | |||
MBO | 522 (32%) | 330 (33%) | 192 (31%) | ||
HAVO | 860 (53%) | 548 (55%) | 312 (51%) | ||
VWO | 58 (3,6%) | 34 (3,4%) | 24 (3,9%) | ||
BD | 92 (5,7%) | 42 (4,2%) | 50 (8,2%) | ||
CD | 30 (1,9%) | 21 (2,1%) | 9 (1,5%) | ||
HO | 51 (3,2%) | 27 (2,7%) | 24 (3,9%) | ||
Overig | 0 (0%) | 0 (0%) | 0 (0%) | ||
Onbekend | 0 (0%) | 0 (0%) | 0 (0%) | ||
1n (%) | |||||
2*p<0.05; **p<0.01; ***p<0.001 | |||||
Voordat we in meer detail kansengelijkheid gaan analyseren, onderzoeken we de verdeling van de kansen op retentie voor verschillende groepen studenten voor Geslacht, Aansluiting en Vooropleiding. De verdeling van deze kansen is uniek per opleiding.
Toelichting
# Make a fairness analysis
for(group in c(lSensitive_labels)) {
# Group
Knit_Header(group, 4)
# Determine the most common subgroup = Privileged
sPrivileged <- Get_Privileged(dfOpleiding_inschrijvingen, group)
# Create a fairness object
fobject <- Get_objFairness(explain_lf, group, sPrivileged)
# Create a table from the fairness analysis
dfFairness_totaal <- Get_dfFairness_Total(fobject)
# Create a plot of the fairness analysis
density_plot <- suppressWarnings(
Get_Density_Plot(fobject, group = group)
)
# Save the plot
sPlotname <- glue("density_plot_{tolower(group)}")
sPlotPath <- Get_Plot_Outputpath(sPlotname, mode = "plot",
bestmodel = sBest_model)
suppressWarnings(
Finalize_Plot(
plot_name = density_plot,
save_filepath = sPlotPath,
height_pixels = 250 + (50 * length(unique(dfFairness_totaal$Categorie)))
))
# Show the existing plot
sPlot <- glue("![Verdeling en dichtheid van {tolower(lResearch_settings[['sSucces_label']])} naar {tolower(group)}]({sPlotPath}){{#fig-fairness-check-{tolower(group)}}}")
Knit_Print_Rule(sPlot)
}
Nu we de verdeling van de kansen kennen, maken we een fairness analyse voor Geslacht, Aansluiting en Vooropleiding. Voor elke groep berekenen we de maatstaven die we eerder hebben behandeld.
We maken een plot van de fairness analyse, waarbij we per variabele één categorie nemen als de bevoorrechte groep; hiervoor hanteren we – zoals al aangegeven – per variabele de meest frequente groep. Het is waarschijnlijk dat in een opleiding de voorlichting, begeleiding en onderwijs het meest heeft afgestemd op deze groep.
Als binnen een variabele een groep een ratio heeft die naar links of naar rechts afwijkt, kan dit duiden op een verschil in kansengelijkheid. Let erop dat de bevoorrechte groep zelf hier niet in is opgenomen (!). Mochten alle overige groepen naar links of rechts afwijken, dan is er sprake van een bias naar de bevoorrechte groep.
Het wijkt af als de balken verder buiten het groene vlak komen en in het rode vlak; dit is gebaseerd op een marge, epsilon, van 0,8. Deze marge is gebaseerd op het 4/5 principe: er is sprake van een te groot verschil als de maat voor een beschermde groep 4/5 of meer afwijkt van de bevoorrechte groep. Een epsilon van 0,8 leidt tot marges van -0,2 (epsilon/1) en +0,25 (1/espilon). Als er twee ratio’s of meer buiten deze marges vallen, is er volgens dit criterium sprake van bias. Als een maatstaf naar links afwijkt is er sprake van bias naar de beschermde groep (ten nadele), als deze naar rechts afwijkt is er sprake van bias naar de bevoorrechte groep (ten voordele).
Alle afwijkingen samen worden opgeteld als absolute waarden en uitgedrukt in de maat ‘Totaal verlies’. Hoe hoger de waarde hiervan is, des te groter de verschillen zijn tussen groepen.
Als de uitkomstmaat van een model negatief is (zoals uitval), dan moet de interpretatie precies andersom gemaakt worden. Dit geldt voor alle maatstaven van bias en fairness in dit hoofdstuk.
Om de robuustheid en betrouwbaarheid in de detectie van bias te waarborgen, moeten er minstens twee metrieke waarden buiten de epsilon-marges vallen voordat er sprake is van bias (Barocas et al., 2023).
Hiervoor is een aantal redenen:
1. Meerdere indicatoren: Het gebruik van meerdere maatstaven zorgt ervoor dat we de detectie van bias niet baseren op slechts een, mogelijk ruisgevoelige, indicator. Als slechts één metriek buiten de marges valt, kan dit toeval zijn of te wijten zijn aan andere niet-systematische fouten in de data. We spreken dan nog niet over bias. Meerdere metrieke afwijkingen geven een sterkere indicatie van een systematisch probleem.
2. Differentie van bias types: Bias kan zich op verschillende manieren manifesteren, bijvoorbeeld in termen van ongelijksoortige impact, ongelijke kansen in voorspellingen of ongelijke behandeling. Door meerdere maatstaven te evalueren, onderzoeken we een breder spectrum van potentiële bias en zien we geen aspecten over het hoofd.
3. Normatieve overwegingen: Vaak is er een normatieve basis voor het definiëren van wat eerlijk is. Het vergelijken van meerdere maatstaven kan helpen om genuanceerder en vollediger beeld te krijgen van hoe een model presteert ten opzichte van verschillende fairness criteria.
De keuze voor twee maatstaven als minimum baseren we op een combinatie van statistische overwegingen en praktische normen binnen het machine learning vakgebied om een goed evenwicht te vinden tussen sensitiviteit (het detecteren van daadwerkelijke bias) en specificiteit (het vermijden van vals positieven) (Barocas et al., 2023).
# Make a fairness analysis
for(group in c(lSensitive_labels)) {
# Group
Knit_Header(group, 4)
# Determine the most common subgroup = Privileged
sPrivileged <- Get_Privileged(dfOpleiding_inschrijvingen, group)
# Create a fairness object
fobject <- Get_objFairness(explain_lf, group, sPrivileged)
# Create a table from the fairness analysis
dfFairness_totaal <- Get_dfFairness_Total(fobject)
# Check for bias
Print_Fairness_Object_LTA(fobject)
# Create a plot of the fairness analysis
fairness_plot <- suppressWarnings(
Get_Fairness_Plot(fobject, group = group, privileged = sPrivileged) +
theme(panel.border = element_rect(
colour = "darkgrey",
fill = NA,
size = 0.4
))
)
# Save the plot
sPlotname <- glue("fairness_plot_{tolower(group)}")
sPlotPath <- Get_Plot_Outputpath(sPlotname, mode = "plot", bestmodel = sBest_model)
suppressWarnings(
Finalize_Plot(
plot_name = fairness_plot,
save_filepath = sPlotPath,
height_pixels = 250 + (50 * length(unique(dfFairness_totaal$Categorie)))
))
# Show the existing plot
sPlot <- glue("{{#fig-fairness-check-{tolower(group)}}}")
Knit_Print_Rule(sPlot)
# Keep the fairness check data
sFairness_outputpath <- Get_Model_Outputpath(mode = "fairness", group = group)
dfFairness_check_data <- Get_dfFairness_Check_Data(fobject[["fairness_check_data"]], group = group)
saveRDS(dfFairness_check_data, file = sFairness_outputpath)
}Prognosemodel (Random Forest) niet geslaagd: 3 van 5 maatstaven
Totaal verlies : 1.84
Prognosemodel (Random Forest) niet geslaagd: 1 van 5 maatstaven
Totaal verlies : 2.82
Prognosemodel (Random Forest) niet geslaagd: 3 van 5 maatstaven
Totaal verlies : 3.16
lDfFairness <- list()
# Walk over the variables
for(i in c(lSensitive_labels)) {
sFairness_outputpath <- Get_Model_Outputpath(mode = "fairness", group = i)
lDfFairness[[i]] <- readRDS(sFairness_outputpath) |>
mutate(FRN_Bias = case_when(FRN_Score < 0.8 ~ "Negatieve Bias",
FRN_Score > 1.25 ~ "Positieve Bias",
.default = "Geen Bias"))
}
# Create a table from the fairness analysis
dfFairness_wide <- Get_dfFairness_Wide(lDfFairness)De uitkomsten van de kansengelijkheidsanalyse is:
# Now create a text per variable from the table
lConclusies <- list()
for(i in lSensitive_labels) {
lConclusies[[i]] <- Get_Fairness_Conclusies(dfFairness_wide, i)
}
# Dynamically generate the conclusions in text
j <- 1
for (i in lSensitive_labels) {
cat(glue("{j}. **{i}**: {lConclusies[[i]]} \n\n"))
j <- j + 1
}# Create a flextable
ftFairness_table <- Get_ftFairness(flextable(dfFairness_wide |>
select(-c(Groep_label, Text))))
# Print the flextable
ftFairness_tableVariabele | Groep | N | % | Bias | Geen Bias | Negatieve Bias | Positieve Bias |
|---|---|---|---|---|---|---|---|
Geslacht | M | 915 | 56,7 | NTB | 0 | 0 | 0 |
V | 698 | 43,3 | Ja | 3 | 0 | 2 | |
Aansluiting | Direct | 756 | 46,9 | NTB | 0 | 0 | 0 |
Tussenjaar | 176 | 10,9 | Nee | 5 | 0 | 0 | |
Switch intern | 202 | 12,5 | Nee | 5 | 0 | 0 | |
Switch extern | 445 | 27,6 | Nee | 5 | 0 | 0 | |
2e Studie | 15 | 0,9 | Ja | 3 | 2 | 0 | |
Na CD | 19 | 1,2 | Nee | 4 | 1 | 0 | |
Vooropleiding | MBO | 522 | 32,4 | Nee | 5 | 0 | 0 |
HAVO | 860 | 53,3 | NTB | 0 | 0 | 0 | |
VWO | 58 | 3,6 | Nee | 5 | 0 | 0 | |
BD | 92 | 5,7 | Ja | 3 | 2 | 0 | |
CD | 30 | 1,9 | Nee | 4 | 1 | 0 | |
HO | 51 | 3,2 | Nee | 5 | 0 | 0 |
Toelichting:
Verantwoording
Deze analyse maakt deel uit van het onderzoek naar kansengelijkheid van het lectoraat Learning Technology & Analytics van De Haagse Hogeschool: No Fairness without Awareness | Het rapport is door het lectoraat ontwikkeld in Quarto 1.6.39.
Creative Commons Licentie
De licentie voor dit template is de Creative Commons Attribution Share Alike 4.0 Internationaal.